HPAVC/HPAVC CD-ROM.iso/FGFADE11.ZIP/FADE.BAS

BASIC Source File | 1995-02-13 | 8KB | 216 lines

'*****************************************************************************
'                                                                            *
'  FADE.BAS                                                                  *
'                                                                            *
'  This program demonstrates how to perform a smooth palette fade with       *
'  Fastgraph.  This example assumes a 256-color video mode with 6-bit DAC    *
'  values (i.e., between 0 and 63).  These values are defined at the top of  *
'  this file, so you can change them easily.                                 *
'                                                                            *
'  The fadein() and fadeout() routines in this program were originally       *
'  written by John Wagner, author of the IMPROCES image processing program.  *
'                                                                            *
'  To compile this program and link it with Fastgraph version 4.0:           *
'                                                                            *
'    BC /O FADE;                        (QuickBASIC 4.5)                     *
'    LINK FADE,,NUL,FGQB;                                                    *
'                                                                            *
'    BC /Fs /O FADE;                    (BASIC PDS 7.x)                      *
'    LINK FADE,,NUL,FGQBX;                                                   *
'                                                                            *
'    BC /O FADE;                        (Visual Basic for DOS)               *
'    LINK FADE,,NUL,FGVBDOS;                                                 *
'                                                                            *
'  This program also can be linked with Fastgraph/Light version 4.0 if you   *
'  replace the FGxxx library references with FGLxxx.                         *
'                                                                            *
'  Fastgraph (tm) and Fastgraph/Light (tm) are graphics libraries published  *
'  by Ted Gruber Software.  For more info, please call, write, or FAX.       *
'                                                                            *
'  Ted Gruber Software                           orders/info [phone]  *
'  PO Box 13408                                          FAX [phone]  *
'  Las Vegas, NV  89112                                  BBS [phone]  *
'                                                                            *
'*****************************************************************************

REM $INCLUDE: 'fastgraf.bi'

DEFINT A-Z

REM function declarations

DECLARE SUB FadeIn (PCXfile$, Delay)
DECLARE SUB FadeOut (Delay)
DECLARE SUB Pack (DacString$, Dacs())
DECLARE SUB Unpack (DacString$, Dacs())

REM these values can be changed for different video modes

CONST NDACS = 256
CONST NCOLORS = 64
CONST VideoMode = 19
CONST ArraySize = NDACS * 3

REM these global arrays hold two complete sets of DAC values

DIM SHARED Dacs1(ArraySize) AS INTEGER
DIM SHARED Dacs2(ArraySize) AS INTEGER
DIM SHARED DacString AS STRING*ArraySize

REM start of main program

REM make sure the requested graphics mode is available

IF (FGtestmode(VideoMode,1) = 0) THEN
   PRINT "This program requires a "; NDACS; "-color graphics mode."
   STOP
END IF

REM calculate the base delay between DAC updates

Delay = FGmeasure / 128

REM initialize Fastgraph for the requested video mode

OldMode = FGgetmode
FGsetmode VideoMode

REM for each PCX file, fade it in and then back out

FadeIn "TOMMY.PCX"+CHR$(0), Delay
FGwaitfor 36
FadeOut Delay
FGwaitfor 18

FadeIn "BALLOONS.PCX"+CHR$(0), Delay
FGwaitfor 36
FadeOut Delay*2
FGwaitfor 18

FadeIn "MOUSE.PCX"+CHR$(0), Delay
FGwaitfor 36
FadeOut Delay*4

REM restore the original video mode and screen attributes

FGsetmode OldMode
FGreset

END

'*****************************************************************************
'                                                                            *
'  FadeIn                                                                    *
'                                                                            *
'  Display an image by gradually increasing each DAC's RGB components to     *
'  their original values.                                                    *
'                                                                            *
'*****************************************************************************

SUB FadeIn (PCXfile$, Delay)

REM get the target DAC values from the PCX file

Status = FGpcxpal(PCXfile$,DacString)
Unpack DacString, Dacs1()

REM zero all of the DACs

DacString = STRING$(ArraySize,0)
FGsetdacs 0, NDACS, DacString
Unpack DacString, Dacs2()

REM display the blacked-out PCX image

Status = FGshowpcx(PCXfile$,1)

REM cycle through the DACs, gradually increasing them to their old values

FOR J = 0 TO NCOLORS-1

   REM increment each RGB component if it is below its old value

   Target = NCOLORS - J

   FOR I = 0 TO ArraySize-1
      IF (Dacs1(I) > Target) AND (Dacs2(I) < Dacs1(I)) THEN Dacs2(I) = Dacs2(I) + 1
   NEXT

   REM update the DACs each time through the loop

   FGstall Delay
   Pack DacString, Dacs2()
   FGsetdacs 0, NDACS, DacString

NEXT

END SUB

'*****************************************************************************
'                                                                            *
'  FadeOut                                                                   *
'                                                                            *
'  Erase an image by gradually fading each DAC's RGB components to black.    *
'                                                                            *
'*****************************************************************************

SUB FadeOut (Delay)

REM load the dacs1 and dacs2 arrays with the current DAC values

FGgetdacs 0, NDACS, DacString
Unpack DacString, Dacs1()
Unpack DacString, Dacs2()

REM cycle through the DACs, gradually reducing them to 0 (black)

FOR J = 0 TO NCOLORS-1

   REM decrement each RGB component if it is above 0

   FOR I = 0 TO ArraySize-1
      IF (Dacs2(I) > 0) THEN Dacs2(I) = Dacs2(I) - 1
   NEXT

   REM update the DACs each time through the loop

   FGstall Delay
   Pack DacString, Dacs2()
   FGsetdacs 0, NDACS, DacString

NEXT

END SUB

'*****************************************************************************
'                                                                            *
'  Pack                                                                      *
'                                                                            *
'  Pack the values from an integer array into a string variable.             *
'                                                                            *
'*****************************************************************************

SUB Pack (DacString$, Dacs())

FOR I = 0 TO ArraySize-1
   MID$(DacString$,I+1,1) = CHR$(Dacs(I))
NEXT

END SUB

'*****************************************************************************
'                                                                            *
'  Unpack                                                                    *
'                                                                            *
'  Unpack the values from a string variable into an integer array.           *
'                                                                            *
'*****************************************************************************

SUB Unpack (DacString$, Dacs())

FOR I = 0 TO ArraySize-1
   Dacs(I) = ASC(MID$(DacString$,I+1,1))
NEXT

END SUB